PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/tvmacro.exe/MACROS.PAS

Pascal/Delphi Source File | 1992-01-31 | 19.5 KB | 701 lines

unit Macros;

(***************************************************************************)
(*                          Turbo Vision Macros                            *)
(*                       $25 Shareware, Version 1.0                        *)
(*                                                                         *)
(*            (c) Copyright 1992 Cybersoft & Lawrence V. Koepke            *)
(*                          All Rights Reserved                            *)
(*                                                                         *)
(*                               Cybersoft                                 *)
(*                   1921 Minto Dr., San Jose, CA 95132                    *)
(*                             [phone]                              *)
(***************************************************************************)

{$X+}
{.$DEFINE TESTING}

{
Turbo Vision Macros is a complete Event Macro Handler, and is released as
Shareware. If you find it useful, please support my efforts. I am an
independant developer. I have no job... I support the wife and kids with my
wits and perseverance to succeed. If enough people support my efforts with
TV Macros, I may even release future versions that support advanced features
(i.e. Loops, If-Then, etc.)! I encourage you to pass this code on to your
friends and colleagues, for, if nothing else, I'm sure that it will make some
people's jobs easier; but, please, do not pass on modified code... let's
have some version control here, send me your modifications.

This unit Replaces TApp.GetEvent with a method having the following features:
- Records events as macros
- Plays back events in macros
- Both Mouse and Keyboard supported
- Macros can record the playback of other macros
- Macros are selected from a pick-list for playback
- Macros are given a name up to 50 characters long
- Halt playback with Escape and confirmation (requires MsgBox)
- Adds app. 16K to the application (with integrated debugger information)
- All non-current macros are kept on disk, macros are only loaded when run
- Does NOT replace BIOS keyboard interrupt 16 or 9
- Macros are stored in two files : MACROS.NDX and MACROS.MAC.

Macros requires units Lists and Picks (also from Cybersoft) to compile.
}

interface
uses App, Drivers, Picks, Lists, StdDlg, Objects, Dialogs;

type
     (*-------- The basic App type to include macros ------------------*)

     PMacApp = ^TMacApp;
     TMacApp = object (TApplication)
       constructor Init;
       destructor Done; virtual;
       procedure GetEvent (var Event : TEvent); virtual;
     end;

     (*-------- The Macro Dialog (replaces event handler) ----------*)

     PMacDialog = ^TMacDialog;
     TMacDialog = object (TDialog)
       procedure HandleEvent (var Event : TEvent); virtual;
     end;

     (*-------- Macro file record ----------------------------------*)

     AMacroRecord = TEvent;                  {used to define file record}


     (*-------- Macro Index file record ----------------------------*)

     AMacroIndex = Record
                     Name   : String [50];
                     Start,
                     Length : Integer;
                   end;


     (*-------- The Macro ------------------------------------------*)
     { Each macro is a collection of Events of type TEvent. }

     PMacro = ^TMacro;
     TMacro = object (TQueue)
     end;


     (*------- A stack of macros. ----------------------------------*)
     { Used to store interrupted macros (ones that call
       other macros. (A Stack of Queues, so to speak.) }

     PMacroStack = ^TMacroStack;
     TMacroStack = object(TStack)
       procedure PushMacro (Macro : PMacro);
     end;

     (*------- The macro picklist ----------------------------------*)

     (* - - - - - - - - -- - - - - - -- - - - - *)

     { Used for Sorted macro list. }
     TSortRecord = record
       Name : String [50];
       RecNUm : integer;
     end;

     PMacroList = ^TMacroList;
     TMacroList = object (TSortedCollection)
       function Compare (Key1, Key2 : Pointer): Integer; virtual;
       procedure FreeItem (Item : Pointer); virtual;
     end;

     PMacroListBox = ^TMacroListBox;
     TMacroListBox = object (TSortedListBox)        {from StdDlg}
       procedure HandleEvent (var Event : TEvent); virtual;
       function GetText (Item : Integer; MaxLen : Integer) : String; virtual;
     end;

     (*-------------------------------------------------------------*)
     PEvent = ^TEvent;


procedure StartRecording;
procedure StopRecording;
procedure StartPlayback;
procedure StopPlayback;
procedure DeleteMacro; {Can this be disabled during Recording or playback?}

implementation
uses Views, Strings, Crt, MsgBox;

type PSortRecord = ^TSortRecord;

var
   MacroFile          : file of AMacroRecord;      {file of macros}
   MacroFileIndex     : file of AMacroIndex;       {file of indexes to macros}
   MacFileName        : string;                    {file name root; no ext.}
   RecordMacIndex     : AMacroIndex;               {1 index record}
   MacPickList        : PPickList;                 {picklist of macros}
   MacStack           : PMacroStack;               {collection of macros}
   InRecording,
   InPlayback         : boolean;                   {states}
   PtrEvent           : PEvent;                    {used only in GetEvent}
   OurMacro           : PMacro;                    {the current macro}
   CheckHalt          : boolean;                   {allows macro interruption}



(* ------------------------- The Macro Files ---------------------------- *)

function OpenMacroFiles (Filename : string): boolean;
var ok : boolean;
begin
  ok := false;
{$I-}
  Assign (MacroFile, Filename + '.MAC');
  Reset (MacroFile);
  ok := IOResult = 0;
  if not ok then
  begin
    Rewrite (MacroFile);
    ok := IOResult = 0;
    if not ok then
      MessageBox('Couldn''t open or create macro data file.',
                 nil, mfOKButton);
  end;

  if ok then
  begin
    Assign (MacroFileIndex, Filename + '.NDX');
    Reset (MacroFileIndex);
    ok := IOResult = 0;
    if not ok then
    begin
      Rewrite (MacroFileIndex);
      ok := IOResult = 0;
      if not ok then
        MessageBox('Couldn''t open or create macro index file.',
                   nil, mfOKButton);
    end;
  end;

  OpenMacroFiles := ok;
{$I+}
end;


procedure CloseMacrofiles;
begin
  Close (MacroFile);
  Close (MacroFileIndex);
end;



(* ------------------------ The Macro Dialog Box ------------------------- *)

{This HandleEvent replaces the space with an underscore because StdDlg's
 TSortedListBox does not recognize spaces with alphanumeric searches for
 the list items. This HandleEvent also converts characters to upper-case,
 since TSortedListBox is case-sensitive.}
procedure TMacDialog.HandleEvent (var Event : TEvent);
begin
  if Event.What = evKeyDown then
    if Event.CharCode = #32 then
      Event.CharCode := #95
    else
      Event.CharCode := UpCase(Event.CharCode);
  TDialog.HandleEvent (Event);
end;


FUNCTION MakeDialog : PMacDialog;
var
  Dlg : PMacDialog;
  R : TRect;
  Control, Labl, Histry : PView;
Begin
R.Assign(4,6,76,13);
New(Dlg, Init(R, 'Macro'));

R.Assign(17,2,69,3);
Control := New(PInputLine, Init(R, 50));
Dlg^.Insert(Control);

  R.Assign(2,2,17,3);
  Labl := New(PLabel, Init(R, 'Macro Name  : ', Control));
  Dlg^.Insert(Labl);

R.Assign(46,4,54,6);
Control := New(PButton, Init(R, ' OK ', cmOK, bfDefault));
Dlg^.Insert(Control);

R.Assign(57,4,67,6);
Control := New(PButton, Init(R, 'Cancel', cmCancel, bfNormal));
Dlg^.Insert(Control);

Dlg^.SelectNext(False);
MakeDialog := Dlg;
end;

var
  DataRec : record
    Name : String[50]; {Inputline}
    end;



(* ---------------------------- MacroStack ------------------------------- *)

procedure TMacroStack.PushMacro (Macro : PMacro);
var P : PMacro;
begin
  new (P);
  P := Macro;
  Push(P);
end;

(* --------------------------- Macro PickList stuff -----------------------*)

{ - - - - - - - - - - - - - - - TMacroList - - - - - - - - - - - - - - - - }
{ This is the PSortedCollection descendant that is inserted into the dialog. }

function TMacroList.Compare (Key1, Key2 : Pointer): Integer;
begin
  if PSortRecord(Key1)^.Name = PSortRecord(Key2)^.Name then Compare := 0
  else if PSortRecord(Key1)^.Name > PSortRecord(Key2)^.Name then Compare := 1
  else Compare := -1;
end;

procedure TMacroList.FreeItem (Item : Pointer);
begin
  dispose (PSortRecord(Item));
end;


{ - - - - - - - - - - - - - - - TMacroListBox - - - - - - - - - - - - - - - }

{ The TSortedListbox descendant that is inserted into the dialog. }

{ HandleEvent Converts the space character to the underscore, since
  TSortedListBox does not recognize the underscore. This HandleEvent also
  converts characters to upper-case, since TSortedListBox is case-sensitive.}

procedure TMacroListBox.HandleEvent (var Event : TEvent);
begin
  if Event.What = evKeyDown then
    if Event.CharCode = #32 then
      Event.CharCode := #95
    else
      Event.CharCode := UpCase(Event.CharCode);
  TSortedListBox.HandleEvent (Event);
end;


{ GetText gets the name from the record. }

function TMacroListBox.GetText (Item : Integer; MaxLen : Integer) : String;
var SR : PSortRecord;
begin
  SR := PSortRecord(List^.At(Item));
  GetText := SR^.Name;
end;


{ - - - - - - - - - - - - - - - - Build sorted list - - - - - - - - - - - - }

{ BuildSortedList builds the sorted list that is inserted in the dialog. }

function BuildSortedList (var List : PMacroList): boolean;
var
    MacroFilePos,
    MacroFileIndexPos : Integer;
    PlaybackMacIndex : AMacroIndex;
    OurSortRecord : TSortRecord;
    i : integer;


    { NewRecord creates a pointer and allocates space for the SortRecord. }

    function NewRecord (ASortRecord : TSortRecord): Pointer;
    var P : PSortRecord;
    begin
      new (P);
      P^ := ASortRecord;
      NewRecord := P;
    end;

begin
  if InRecording then
  begin
    MacroFilePos := FilePos (MacroFile);
    MacroFileIndexPos := FilePos (MacroFileIndex);
  end
  else
  if not OpenMacroFiles (MacFilename) then
  begin
    MessageBox ('Build List problem.', nil, mfOKButton);
    exit;
  end;

  BuildSortedList := true;
  List := New(PMacroList,Init(100, 100));
  Seek (MacroFileIndex, 0);
  i := 0;
  while not EOF (MacroFileIndex) do begin
    Read (MacroFileIndex, PlaybackMacIndex);
    OurSortRecord.Name := PlaybackMacIndex.Name;
    OurSortRecord.RecNum := i;
    List^.Insert(NewRecord(OurSortRecord));
    Inc(i);
  end;

  if InRecording then
  begin
    Seek (MacroFile, MacroFilePos);
    Seek (MacroFileIndex, MacroFileIndexPos );
  end
  else
    CloseMacroFiles;
end;

{ - - - - - - - - - - - - - - Pick a Macro - - - - - - - - - - - - - - - - }

function PickMacro (var which : integer) : boolean;
var
    OurList           : PMacroList;
    OurRecord         : TSortRecord;
    ListBox           : PMacroListBox;
    OurScroller       : PView;
    ItemNum           : Integer;

begin
   PickMacro := false;
   New(MacPickList, Init(9,3,70,17));
   {New(MacPickList, Init(6,3,73,21));}
   OurScroller := New(PScrollbar, Init(ScrollBarPRect^));
   ListBox := New(PMacroListBox, Init(ListBoxPRect^, 1, PScrollbar(OurScroller)));
   BuildSortedList (OurList);
   if MacPickList^.ListItemPicked(OurScroller, ListBox, OurList,
                                               'Macros', ItemNum) then
   begin
     PickMacro := true;
     OurRecord := PSortRecord(OurList^.At(ItemNum))^;
     which := OurRecord.RecNum;
   end;
   Dispose (OurList, Done);
   OurList := nil;
   Dispose (MacPickList, Done);
end;

(* ---------------------------- Recording ---------------------------------*)

procedure StartRecording;
var D : PDialog;
    cmd : word;
begin
  D := MakeDialog;
  cmd := Desktop^.ExecView (D);
  if cmd = cmOK then
  begin
    D^.GetData(DataRec);
    RecordMacIndex.Name := DataRec.Name;
    RecordMacIndex.Length := 0;
    if not OpenMacroFiles (MacFileName) then exit;
    Seek (MacroFile, FileSize(MacroFile));
    RecordMacIndex.Start := FileSize(MacroFile);
    InRecording := true
  end;
  Dispose (D, Done);
end;


procedure StopRecording;
begin
  if not InRecording then exit;
  if InPlayback then exit;
  Seek (MacroFileIndex, FileSize(MacroFileIndex));
  Write (MacroFileIndex, RecordMacIndex);
  CloseMacroFiles;
  InRecording := false
end;




(* ------------------------------ Playback --------------------------------*)

{NewEvent creates new pointer for a macro event, much like NewStr does. }

function NewEvent (Event : TEvent) : Pointer;
var PtrEvent : PEvent;
begin
  new (PtrEvent);
  PtrEvent^ := Event;
  NewEvent := PtrEvent;
end;


procedure StartPlayback;
var ItemNum, i        : Integer;
    OurEvent          : TEvent;
    MacroFilePos,
    MacroFileIndexPos : Integer;
    MacroIndexRec     : AMacroIndex;

begin
   if PickMacro (ItemNum) then
   begin
     if InRecording then
     begin
       MacroFilePos := FilePos (MacroFile);
       MacroFileIndexPos := FilePos (MacroFileIndex);
     end
     else
     if not OpenMacroFiles (MacFilename) then
     begin
       Dispose (MacPickList, Done);
       exit;
     end;

     if OurMacro <> nil then
       MacStack^.Push (OurMacro);
     new (OurMacro, Init (SizeOf (TEvent)));
     Seek (MacroFileIndex, ItemNum);
     Read (MacroFileIndex, MacroIndexRec);

     {Build macro collection}
     for i := MacroIndexRec.Start to
             (MacroIndexRec.Start + MacroIndexRec.length - 1) do
     begin
       Seek (MacroFile, i);
       Read (MacroFile, OurEvent);
       OurMacro^.Insert (NewEvent(OurEvent));
     end;

     if InRecording then
     begin
       Seek (MacroFile, MacroFilePos);
       Seek (MacroFileIndex, MacroFileIndexPos );
     end
     else
       CloseMacroFiles;

     InPlayback := true;
   end;
end;

procedure StopPlayback;
begin
  if MacStack^.NotEmpty then
    OurMacro := MacStack^.Pop
  else
    InPlayback := false;
end;

(* -------------------------- Delete Macro -------------------------- *)

procedure DeleteMacro;
var MacroNum : Integer;
    cmd      : word;
    TempMacroFile      : file of AMacroRecord;      {file of macros}
    TempMacroFileIndex : file of AMacroIndex;       {file of indexes to macros}
    i, j     : Integer;
    IndexRec : AMacroIndex;
    Length   : integer;
    AnEvent  : TEvent;

    function CheckIO : boolean;
    var ok : boolean;
    begin
      ok := IOResult = 0;
      if not ok then
        MessageBox ('File I/O failure with Delete operation.', nil,
                     mfOKButton);
      CheckIO := ok;
    end;

    function IOok : boolean;
    var ok : boolean;
    begin
      ok := CheckIO;
      if not OK then
      begin
        CloseMacroFiles;
        Close (TempMacroFile);
        Close (TempMacroFileIndex);
      end;
    end;


begin
  if InRecording or InPlayback then exit;
  if PickMacro (MacroNum) then
  begin
    cmd := MessageBox ('Really delete macro?', nil, mfYesNoCancel);
    if cmd = cmYes then
    begin
      if OpenMacroFiles (MacFileName) then
      begin                                         {Create temporary files }
        Assign (TempMacroFile, 'TEMP.MAC');         {to copy macros into.   }
        Assign (TempMacroFileIndex, 'TEMP.NDX');
        {$I-}
        Rewrite (TempMacroFile);
        if not CheckIO then
        begin
          CloseMacroFiles;
          exit;
        end;
        Rewrite (TempMacroFileIndex);
        if not CheckIO then
        begin
          CloseMacroFiles;
          Close (TempMacroFile);
          exit;
        end;

        i := 0; Length := 0;
        While not Eof(MacroFileIndex) do
        begin
          Read (MacroFileIndex, IndexRec);
          if not IOok then exit;
          if i <> MacroNum then
          begin
            IndexRec.Start := IndexRec.Start - Length; {Adjust for deletion.}
            Write (TempMacroFileIndex, IndexRec);      {Copy index record   }
            if not IOok then exit;                     {to temporary file.  }
            for j := 1 to IndexRec.Length do           {Copy macro to the   }
            begin                                      {temporary file.     }
              Read (MacroFile, AnEvent);
              if not IOok then exit;
              Write (TempMacroFile, AnEvent);
              if not IOok then exit;
            end;
          end
          else
          begin
            Length := IndexRec.Length;               {Get deletion adjustment.}
            for j := 1 to IndexRec.Length do         {Move to next macro,   }
            begin                                    {by skipping this one. }
              Read (MacroFile, AnEvent);
              if not IOok then exit;
            end;
            Length := 0;                             {Reset adjustment.     }
          end;
          Inc (i);
        end;

        CloseMacroFiles;
        Close (TempMacroFileIndex);
        Close (TempMacroFile);
        Erase (MacroFile);
        Erase (MacroFileIndex);
        Rename (TempMacroFileIndex, MacFileName + '.NDX');
        Rename (TempMacroFile, MacFileName + '.MAC');
      end;
    end;
  end;
end;


(* -------------------------- MacApp -------------------------------- *)

constructor TMacApp.Init;
begin
  TApplication.Init;
end;

destructor TMacApp.Done;
begin
  TApplication.Done;
end;

procedure TMacApp.GetEvent (var Event : TEvent);
var cmd : word;
Label TheEnd;

begin

  if CheckHalt or ((not InRecording) and (not InPlayback)) then
    TApplication.GetEvent(Event)
  else
  if InRecording and not InPlayback then
  begin
    TApplication.GetEvent(Event);
    if Event.What <> evNothing then
    begin
      {$I-}
      Write (MacroFile, Event);
      RecordMacIndex.Length := RecordMacIndex.Length + 1;
      if IOResult <> 0 then
      MessageBox ('Couldn''t write event to macro file.', nil, mfOKButton);
      {$I+}
    end;
  end
  else

  if InPlayback then
  begin
{$IFDEF TESTING}
    delay (10);       {testing}
{$ENDIF}

    {check for macro interrupt with Escape key}
    GetKeyEvent(Event);
    if Event.What and evKeyboard <> 0 then
    begin
      if Event.KeyCode = kbEsc then
      begin
        CheckHalt := true;
        cmd := MessageBox ('Halt playback of macro?', nil, mfYesNoCancel);
        if cmd = cmYes then
        begin
          CheckHalt := false;
          dispose (OurMacro, Done);
          OurMacro := nil;
          while MacStack^.NotEmpty do
          begin
            OurMacro := MacStack^.Pop;
            dispose (OurMacro, Done);
            OurMacro := nil;
          end;
          InPlayback := false;
          ClearEvent (Event);
          PutEvent (Event);
          goto TheEnd;
        end;
        CheckHalt := false;
      end;
    end;

    if OurMacro^.NotEmpty then
    begin
      PtrEvent := OurMacro^.Extract;
      Event := PtrEvent^;
      dispose (PtrEvent);
    end
    else
    begin
      dispose (OurMacro, Done);
      OurMacro := nil;
      StopPlayback;
      ClearEvent (Event);
    end;

  end;
TheEnd:
end;



begin
  MacFileName := 'MACROS';
  new (MacStack, Init(SizeOf(TMacro)));
  InRecording := false;
  InPlayback  := false;
  new (PtrEvent);
  OurMacro := nil;
  InRecording := false;
  InPlayback := false;
  CheckHalt := false;
end.